home *** CD-ROM | disk | FTP | other *** search
/ Kit PC World De Ampliacion De Windows 95 / Kit PC World de ampliacion de Windows 95.iso / clarion / cw15 / examp15.z / LIBMAKER.CLW < prev    next >
Text File  |  1995-09-09  |  13KB  |  447 lines

  1.      PROGRAM
  2.  
  3.      INCLUDE('KEYCODES.CLW')
  4.  
  5.      MAP
  6.         ReadExecutable
  7.         DumpPEExports
  8.         DumpNEExports
  9.         WriteLib
  10.         ReadLib
  11.         InfoWindow
  12.      END
  13.  
  14. FileName STRING(255)            ! File name for input and output files
  15.  
  16. ! LIBfile is used to read and write import library files
  17.  
  18. LIBfile  FILE,DRIVER('DOS','/FILEBUFFERS=20'),PRE(LIB),CREATE,NAME(FileName)
  19.            RECORD
  20. RawBytes     BYTE,DIM(1024)
  21. header       GROUP,OVER(RawBytes)
  22. typ            BYTE             ! OMF record type = 88H (Coment)
  23. len            USHORT           ! Size of OMF record to follow
  24. kind           USHORT           ! Comment kind = 0A000H
  25. bla            BYTE             ! Always 1 for our purposes
  26. ordflag        BYTE             ! ditto
  27.              END
  28. ! For the records we want, the header is follower by the pubname
  29. ! and modname in PSTRING format, then the ordinal export number (USHORT)
  30.  
  31. pstringval   PSTRING(128),OVER(RawBytes)
  32. ushortval    USHORT,OVER(RawBytes)
  33.            END
  34.          END
  35.  
  36. ! EXEfile is used for reading NE and PE format executable files
  37.  
  38. EXEfile  FILE,DRIVER('DOS','/FILEBUFFERS=20'),PRE(EXE),NAME(FileName)
  39.            RECORD
  40. RawBytes     BYTE,DIM(1024)
  41. cstringval   CSTRING(128),OVER(RawBytes)
  42. pstringval   PSTRING(128),OVER(RawBytes)
  43. ulongval     ULONG,OVER(RawBytes)
  44. ushortval    USHORT,OVER(RawBytes)
  45.  
  46. ! DOSheader is the old exe (stub) header format
  47. DOSheader    GROUP,OVER(RawBytes)
  48. dos_magic      STRING(2)         ! contains 'MZ'
  49. dos_filler     USHORT,DIM(29)    ! we don't care about these fields
  50. dos_lfanew     ULONG             ! File offset of new exe header
  51.              END
  52.  
  53. ! NEheader is the new exe (16-bit) header format
  54. NEheader     GROUP,OVER(RawBytes)
  55. ne_magic       STRING(2)         ! Contains 'NE'
  56. ne_ver         BYTE
  57. ne_rev         BYTE
  58. ne_enttab      USHORT
  59. ne_cbenttab    USHORT
  60. ne_crc         LONG
  61. ne_flags       USHORT
  62. ne_autodata    USHORT
  63. ne_heap        USHORT
  64. ne_stack       USHORT
  65. ne_csip        ULONG
  66. ne_sssp        ULONG
  67. ne_cseg        USHORT
  68. ne_cmod        USHORT
  69. ne_cbnrestab   USHORT
  70. ne_segtab      USHORT
  71. ne_rsrctab     USHORT
  72. ne_restab      USHORT
  73. ne_modtab      USHORT
  74. ne_imptab      USHORT
  75. ne_nrestab     ULONG
  76. ne_cmovent     USHORT
  77. ne_align       USHORT
  78. ne_rescount    USHORT
  79. ne_osys        BYTE
  80. ne_flagsother  BYTE
  81. ne_gangstart   USHORT
  82. ne_ganglength  USHORT
  83. ne_swaparea    USHORT
  84. ne_expver      USHORT           ! Expected Window version number
  85.              END
  86.  
  87. ! PEheader is the flat-model (32-bit) header format (PE signature)
  88. PEheader     GROUP,OVER(RawBytes)
  89. pe_signature   ULONG
  90. pe_machine     USHORT
  91. pe_nsect       USHORT
  92. pe_stamp       ULONG
  93. pe_psymbol     ULONG
  94. pe_nsymbol     ULONG
  95. pe_optsize     USHORT
  96. pe_character   USHORT
  97.              END
  98.  
  99. ! SectHeader describes a section in a PE file
  100. SectHeader GROUP,OVER(RawBytes)
  101. sh_SectName  CSTRING(8)
  102. sh_VirtSize  ULONG
  103. sh_PhysAddr  ULONG,OVER(sh_VirtSize)
  104. sh_VirtAddr  ULONG
  105. sh_RawSize   ULONG
  106. sh_RawPtr    ULONG
  107. sh_Reloc     ULONG
  108. sh_LineNum   ULONG
  109. sh_RelCount  USHORT
  110. sh_LineCount USHORT
  111. sh_Character ULONG
  112.            END
  113.  
  114. ! ExpDirectory is at start of a .edata section in a PE file
  115. ExpDirectory GROUP,OVER(RawBytes)
  116. exp_Character   ULONG
  117. exp_stamp       ULONG
  118. exp_Major       USHORT
  119. exp_Minor       USHORT
  120. exp_Name        ULONG
  121. exp_Base        ULONG
  122. exp_NumFuncs    ULONG
  123. exp_NumNames    ULONG
  124. exp_AddrFuncs   ULONG
  125. exp_AddrNames   ULONG
  126. exp_AddrOrds    ULONG
  127.               END
  128.             END
  129.           END
  130.  
  131. newoffset ULONG   ! File offset to NE/PE header
  132.  
  133. ExportQ   QUEUE,PRE(EXQ)
  134. symbol      STRING(128)
  135. icon        SHORT
  136. treelevel   SHORT
  137. ordinal     USHORT
  138. module      STRING(20)
  139.           END
  140.  
  141. oldheight USHORT
  142. oldwidth  USHORT
  143. xdelta    SHORT
  144. ydelta    SHORT
  145. float     REAL
  146.  
  147. window WINDOW('LibMaker'),AT(,,178,123),CENTER,IMM,ICON('LIBRARY.ICO'),ALRT(DeleteKey),SYSTEM,GRAY,RESIZE
  148.        LIST,AT(13,10,150,65),FONT('Arial',8,,FONT:regular),USE(?List1),DISABLE,VSCROLL,COLUMN,FORMAT('130L(5)IT(L)20L@N_5B@'), |
  149.            FROM(ExportQ)
  150.        BUTTON('&Add file...'),AT(13,83,40,14),USE(?AddFile)
  151.        BUTTON('&Save as...'),AT(69,83,40,14),USE(?SaveAs),DISABLE
  152.        BUTTON('Info...'),AT(127,83,40,14),USE(?Info)
  153.        BUTTON('Clear'),AT(36,105,40,14),USE(?Clear)
  154.        BUTTON('&Close'),AT(103,105,40,14),USE(?Close),STD(STD:Close)
  155.      END
  156.  
  157.    CODE
  158.    OPEN(window)
  159.    ?List1{PROP:iconlist, 1} = '~Opened.ico'
  160.    ?List1{PROP:iconlist, 2} = '~Closed.ico'
  161.    oldheight = window{PROP:height}
  162.    oldwidth = window{PROP:width}
  163.    window {PROP:minheight} = oldheight
  164.    window {PROP:minwidth} = oldwidth
  165.    ACCEPT
  166.       CASE ACCEPTED()
  167.       OF ?Info
  168.          InfoWindow
  169.       OF ?Clear
  170.          FREE(ExportQ)
  171.          DISABLE(?SaveAs)
  172.          DISPLAY
  173.       OF ?AddFile
  174.         IF FileDialog('Import symbols from file ...', FileName, |
  175.                       'DLL files (*.dll)|*.dll|LIB files (*.lib)|*.lib|All files (*.*)|*.*', |
  176.                       FALSE)
  177.           DISPLAY
  178.           SetCursor(CURSOR:Wait)
  179.           IF INSTRING('.LIB', UPPER(FileName), 1, 1)
  180.             ReadLib
  181.           ELSE
  182.             ReadExecutable
  183.           END
  184.           SetCursor()
  185.         END
  186.         DO EnableControls
  187.       OF ?SaveAs
  188.         IF RECORDS(ExportQ)>0
  189.           CLEAR(FileName)
  190.           IF FileDialog('Output library definition to ...', FileName, 'Library files (*.lib)|*.lib|Export files (*.exp)|*.exp', TRUE)
  191.             WriteLib
  192.           END
  193.         END
  194.       END
  195.       CASE EVENT()
  196.       OF EVENT:expanded
  197.       OROF EVENT:contracted
  198.         i# = ?List1{PROPLIST:MouseDownRow}
  199.         GET(ExportQ, i#)
  200.         exq:treelevel = -exq:treelevel
  201.         IF exq:icon = 1
  202.           exq:icon = 2
  203.         ELSE
  204.           exq:icon = 1
  205.         END
  206.         PUT(ExportQ)
  207.         DISPLAY(?list1)
  208.       OF EVENT:Sized
  209.         ydelta = window{PROP:height}-oldheight
  210.         xdelta = window{PROP:width}-oldwidth
  211.         SetPosition(?AddFile,,?AddFile{PROP:ypos}+ydelta)
  212.         SetPosition(?SaveAs,?SaveAs{PROP:xpos}+xdelta/2,?SaveAs{PROP:ypos}+ydelta)
  213.         SetPosition(?Close,?Close{PROP:xpos}+xdelta,?Close{PROP:ypos}+ydelta)
  214.         SetPosition(?List1,,,?List1{PROP:width}+xdelta, ?list1{PROP:height}+ydelta)
  215.         oldheight = window{PROP:height}
  216.         oldwidth = window{PROP:width}
  217.       OF EVENT:AlertKey
  218.         IF KeyCode()=DeleteKey
  219.           GET(ExportQ, CHOICE(?List1))
  220.           DELETE(ExportQ)
  221.           IF (exq:treelevel<2)
  222.             GET(ExportQ, CHOICE(?List1))
  223.             LOOP WHILE (exq:treelevel=2)
  224.               DELETE(ExportQ)
  225.               GET(ExportQ, CHOICE(?List1))
  226.               IF (ERRORCODE())
  227.                 BREAK
  228.               END
  229.             END
  230.           END
  231.           DO EnableControls
  232.           DISPLAY(?list1)
  233.         END
  234.       END
  235.    END
  236.  
  237. EnableControls ROUTINE
  238.    IF RECORDS(ExportQ)
  239.      ENABLE(?list1)
  240.      ENABLE(?SaveAs)
  241.    ELSE
  242.      DISABLE(?list1)
  243.      ENABLE(?SaveAs)
  244.    END
  245.  
  246. ! ReadExecutable gets export table from 16 or 32-bit file or LIB file
  247.  
  248. ReadExecutable PROCEDURE
  249. sectheaders ULONG   ! File offset to section headers
  250. sections    USHORT  ! File offset to section headers
  251.    CODE
  252.    OPEN(EXEfile, 0)
  253.    GET(EXEfile, 1, SIZE(EXE:DOSheader))
  254.    IF EXE:dos_magic = 'MZ' THEN
  255.      newoffset = EXE:dos_lfanew
  256.      GET(EXEfile, newoffset+1, SIZE(EXE:PEheader))
  257.      IF EXE:pe_signature = 04550H THEN
  258.        sectheaders = EXE:pe_optsize+newoffset+SIZE(EXE:PEheader)
  259.        sections = EXE:pe_nsect
  260.        LOOP i# = 1 TO sections
  261.          GET(EXEfile,sectheaders+1,SIZE(EXE:sectheader))
  262.          sectheaders += SIZE(EXE:sectheader)
  263.          IF EXE:sh_SectName = '.edata' THEN
  264.             DumpPEExports
  265.          END
  266.        END
  267.      ELSE
  268.        GET(EXEfile, newoffset+1, SIZE(EXE:NEheader))
  269.        DumpNEExports
  270.      END
  271.    END
  272.    CLOSE(EXEfile)
  273.  
  274. ! DumpPEexports gets export table from a PE format file (32-bit)
  275.  
  276. DumpPEExports PROCEDURE
  277.  
  278. RawPtr    ULONG
  279. VirtAddr  ULONG
  280. NumNames  ULONG
  281. Names     ULONG
  282. Ordinals  ULONG
  283. Base      ULONG
  284.  
  285. j         USHORT
  286.  
  287.    CODE
  288.    RawPtr = EXE:sh_rawptr
  289.    VirtAddr = EXE:sh_virtaddr
  290.    GET(EXEfile, RawPtr+1, SIZE(EXE:ExpDirectory))
  291.    NumNames = EXE:exp_NumNames
  292.    Names = EXE:exp_AddrNames
  293.    Ordinals = EXE:exp_AddrOrds
  294.    Base = EXE:exp_Base
  295.    GET(EXEfile, RawPtr-VirtAddr+EXE:exp_Name+1, SIZE(EXE:cstringval))
  296.    exq:Module = EXE:cstringval
  297.    exq:Symbol = EXE:cstringval
  298.    exq:treelevel = 1
  299.    exq:icon = 1
  300.    exq:ordinal = 0
  301.    ADD(ExportQ)
  302.    exq:treelevel = 2
  303.    exq:icon = 0
  304.    LOOP j = 0 TO NumNames-1
  305.       GET(EXEfile, RawPtr-VirtAddr+Names+j*4+1, SIZE(EXE:ulongval))
  306.       GET(EXEfile, RawPtr-VirtAddr+EXE:ulongval+1, SIZE(EXE:cstringval))
  307.       exq:symbol = EXE:cstringval
  308.       GET(EXEfile, RawPtr-VirtAddr+Ordinals+j*2+1, SIZE(EXE:ushortval))
  309.       exq:ordinal = EXE:ushortval+Base
  310.       ADD(ExportQ)
  311.    END
  312.  
  313. ! DumpNEexports gets export table from a NE format file (16-bit)
  314.  
  315. DumpNEExports PROCEDURE
  316. j  ULONG
  317.    CODE
  318. ! First get the module name - stored as first entry in non-resident name table
  319.    j = EXE:ne_nrestab+1
  320.    GET(EXEfile, newoffset+EXE:ne_restab+1, SIZE(EXE:pstringval))
  321.    exq:Module = EXE:pstringval
  322.    exq:symbol = EXE:pstringval
  323.    exq:ordinal = 0
  324.    exq:treelevel = 1
  325.    exq:icon = 1
  326.    ADD(ExportQ)
  327. ! Now pull apart the resident name table. First entry is the description, and is skipped
  328.    exq:treelevel = 2
  329.    exq:icon = 0
  330.    GET(EXEfile, j, SIZE(EXE:pstringval))
  331.    j += LEN(EXE:pstringval)+1
  332.    GET(EXEfile, j, SIZE(EXE:ushortval))
  333.    j += 2
  334.    LOOP
  335.      GET(EXEfile, j, SIZE(EXE:pstringval))
  336.      IF LEN(EXE:pstringval)=0 THEN
  337.        BREAK
  338.      END
  339.      exq:symbol = EXE:pstringval
  340.      j += LEN(EXE:pstringval)+1
  341.      GET(EXEfile, j, SIZE(EXE:ushortval))
  342.      j += 2
  343.      exq:ordinal = EXE:ushortval
  344.      ADD(ExportQ)
  345.    END
  346.  
  347. ! WriteLib writes out all info in the export Q to a LIB file 
  348.  
  349. WriteLib PROCEDURE
  350. i  USHORT
  351.    CODE
  352.    CREATE(LIBfile)
  353.    OPEN(LIBfile)
  354.    LOOP i = 1 TO RECORDS(ExportQ)
  355.       GET(ExportQ, i)
  356.       IF exq:treelevel=2 THEN
  357.         ! Record size is length of the strings, plus two length bytes, a two byte
  358.         ! ordinal, plus the header length (excluding the first three bytes)
  359.         LIB:typ = 88H
  360.         LIB:kind = 0A000H
  361.         LIB:bla = 1
  362.         LIB:ordflag = 1
  363.         LIB:len = LEN(CLIP(exq:module))+LEN(CLIP(exq:symbol))+2+2+SIZE(LIB:header)-3
  364.         ADD(LIBfile, SIZE(LIB:header))
  365.         LIB:pstringval = CLIP(exq:symbol)
  366.         ADD(LIBfile, LEN(LIB:pstringval)+1)
  367.         LIB:pstringval = CLIP(exq:module)
  368.         ADD(LIBfile, LEN(LIB:pstringval)+1)
  369.         LIB:ushortval = exq:ordinal
  370.         ADD(LIBfile, SIZE(LIB:ushortval))
  371.       END
  372.    END
  373.    CLOSE(LIBfile)
  374.  
  375. ! Readlib reads back in a LIB file output by WriteLib above or by IMPLIB etc
  376.  
  377. ReadLib    PROCEDURE
  378.  
  379. i          USHORT
  380. j          USHORT
  381. lastmodule STRING(20)
  382. modulename STRING(20)
  383. symbolname STRING(128)
  384. ordinal    USHORT
  385.  
  386.    CODE
  387.    OPEN(LIBfile, 0)
  388.    i = 1
  389.    LOOP 
  390.       GET(LIBfile, i, SIZE(LIB:header))     ! Read next OMF record
  391.       IF ERRORCODE() OR LIB:typ = 0 OR LIB:len = 0 THEN
  392.          BREAK                              ! All done
  393.       END
  394.       j = i + SIZE(LIB:header)              ! Read export info from here
  395.       i = i + LIB:len + 3                   ! Read next OMF record from here
  396.       IF LIB:typ = 88H AND LIB:kind = 0A000H AND LIB:bla = 1 AND LIB:ordflag = 1 THEN
  397.           GET(LIBfile, j, SIZE(LIB:pstringval))
  398.           symbolname = LIB:pstringval
  399.           j += LEN(LIB:Pstringval)+1
  400.           GET(LIBfile, j, SIZE(LIB:pstringval))
  401.           modulename = LIB:pstringval
  402.           j += LEN(LIB:Pstringval)+1
  403.           GET(LIBfile, j, SIZE(LIB:ushortval))
  404.           ordinal = LIB:ushortval
  405.           IF modulename <> lastmodule      ! A LIB can describe multiple DLLs
  406.              lastmodule = modulename
  407.              exq:treelevel = 1
  408.              exq:icon = 1
  409.              exq:symbol = modulename
  410.              exq:module = modulename
  411.              exq:ordinal = 0
  412.              ADD(ExportQ)
  413.           END
  414.           exq:treelevel = 2
  415.           exq:icon = 0
  416.           exq:symbol = symbolname
  417.           exq:module = modulename
  418.           exq:ordinal = ordinal
  419.           ADD(ExportQ)
  420.       END
  421.    END
  422.    CLOSE(LIBfile)
  423.  
  424. InfoWindow      PROCEDURE
  425.  
  426. infowin WINDOW('LibMaker Info'),AT(,,217,102),GRAY
  427.        STRING('This program is provided as both a valuable utility'),AT(16,6),USE(?String1)
  428.        STRING('and'),AT(16,20),FONT(,,,FONT:italic),USE(?String2)
  429.        STRING('as a source code example.  The original executable'),AT(34,20),USE(?String3)
  430.        STRING('program is installed in the BIN subdirectory.  If you wish'),AT(16,34),USE(?String4)
  431.        STRING('to make modifications to the example source, make sure'),AT(16,48),USE(?String5)
  432.        STRING('that you are aware of this additional executable.'),AT(16,62),USE(?String6)
  433.        BUTTON('OK'),AT(91,81,35,14),USE(?OkButton),STD(STD:Close),DEFAULT
  434.      END
  435.  
  436.  
  437.         CODE
  438.         OPEN(infowin)
  439.         ACCEPT
  440.          CASE EVENT()
  441.           OF EVENT:Accepted
  442.            CASE FIELD()
  443.             OF ?OKButton
  444.              BREAK
  445.            END
  446.          END
  447.         END